home *** CD-ROM | disk | FTP | other *** search
/ PC Answers 1995 May / PC Answers CD-ROM 7 (Future Publishing) (May 1995).iso / vbits / code / cert / trk3_eg / fmdrgdrp / opt2 / invent.exe / DRAG.BAS < prev    next >
Encoding:
BASIC Source File  |  1993-08-20  |  5.9 KB  |  215 lines
  1. ' Local definitions to remember grid drag mode
  2.  
  3. Dim InitialX As Single
  4. Dim InitialY As Single
  5.  
  6. Const DRAG_DELTA = 30   ' determines when drag starts
  7.  
  8. ' Type masks
  9.  
  10. Global Const MASK_NONE = 0
  11. Global Const MASK_CUST = 1
  12. Global Const MASK_OBROWSE = 2
  13. Global Const MASK_PARTS = 4
  14. Global Const MASK_ORDER = 8
  15. Global Const MASK_TABLE = 16
  16.  
  17. ' Drag mode constants to keep track of dragging activity.
  18.  
  19. Global DragType As Integer         ' type of object being dragged
  20. Dim Dragging As Integer         ' TRUE when dragging is in progress
  21. Dim DragIndex As Integer        ' Optional index of dragged obj
  22. Dim DragRow As Integer          ' Optional row being dragged in grid
  23. Dim DragTesting As Integer      ' TRUE when test drag in progress
  24.  
  25. ' ----------------------------------
  26. ' Microsoft Windows API declarations
  27. ' ----------------------------------
  28.  
  29. ' Type definitions used for grid interfacing
  30.  
  31. Type POINTAPI
  32.     X As Integer
  33.     Y As Integer
  34. End Type
  35.  
  36. Type RECT
  37.     Left As Integer
  38.     Top As Integer
  39.     Right As Integer
  40.     Bottom As Integer
  41. End Type
  42.  
  43. ' TrueGrid message code for returning bounding box of the marquee
  44.  
  45. Const WM_USER = &H400
  46. Const GRM_GETCELLRECT = WM_USER + 62
  47.  
  48. ' Windows API declarations
  49.  
  50. Declare Function SendMessage Lib "User" (ByVal Hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long
  51. Declare Sub ClientToScreen Lib "User" (ByVal Hwnd As Integer, lpPoint As POINTAPI)
  52. Declare Sub GetCursorPos Lib "User" (lpPoint As POINTAPI)
  53.  
  54. Sub BeginDragMode (ctl As Control, objType As Integer)
  55.     
  56.     ' Whenever a drag is about to start, this routine is called.
  57.     ' The type mask of the drag is flagged, and we remember that
  58.     ' dragging is in progress.   This routine MUST be matched
  59.     ' by an EndDragMode function call.
  60.  
  61.     DragType = objType
  62.     Dragging = True
  63.  
  64.     ' Start the drag process
  65.  
  66.     ctl.Drag BEGIN_DRAG
  67.  
  68. End Sub
  69.  
  70. Function CursorInRow (DragGrid As Control) As Integer
  71.  
  72.     ' Return a boolean indicating whether the cursor is within the marquee
  73.  
  74.     Dim Marquee As RECT
  75.     Dim CursorPos As POINTAPI
  76.  
  77.     ' Eliminate the situation where the current cell is not within the visible
  78.     ' area of the grid.
  79.  
  80.     CursorInRow = False
  81.  
  82.     If DragGrid.RowIndex < DragGrid.TopRow Then Exit Function
  83.     If DragGrid.RowIndex > DragGrid.BottomRow Then Exit Function
  84.  
  85.     GetMarquee DragGrid, Marquee
  86.     GetCursorPos CursorPos
  87.  
  88.     If CursorPos.Y >= Marquee.Top And CursorPos.Y <= Marquee.Bottom Then
  89.         CursorInRow = True
  90.     End If
  91.  
  92. End Function
  93.  
  94.  
  95. Function DragValid (src As Control, mask As Integer, State As Integer) As Integer
  96.     
  97.     ' This function is called by an object's DragOver event to
  98.     ' automatically change the drag cursor to the "no drop"
  99.     ' cursor if necessary.  It also returns True if the object
  100.     ' can legally be dropped according to the input mask.
  101.  
  102.     If (mask And DragType) Then
  103.         DragValid = True
  104.         Exit Function
  105.     End If
  106.  
  107.     ' This is not a valid drag.  Return False, but also change the
  108.     ' object's drag icon to the NoDrag icon (remembering the old
  109.     ' value for later restore when we exit this object).
  110.  
  111.     DragValid = False
  112.  
  113.     Select Case State
  114.         
  115.         Case ENTER
  116.  
  117.             ' Entering, remember old icon
  118.  
  119.             Utils.SaveIcon.DragIcon = src.DragIcon
  120.             src.DragIcon = Utils.NoDrag.DragIcon
  121.  
  122.         Case LEAVE
  123.             
  124.             ' Exiting, restore old icon
  125.  
  126.             src.DragIcon = Utils.SaveIcon.DragIcon
  127.  
  128.     End Select
  129.                 
  130. End Function
  131.  
  132. Function EndDragMode (mask As Integer) As Integer
  133.     
  134.     ' This function is called when a drag has ended, either
  135.     ' successfully or unsuccessfully.  This routine removes any
  136.     ' user feedback related to the drag operation and returns
  137.     ' TRUE if the passed mask matches the dragged object.
  138.  
  139.     Select Case DragType
  140.  
  141.         Case MASK_NEWAPPT
  142.  
  143.             ' If a "new appointment" icon was dragged, change the
  144.             ' frame background to LTGREY again so that the drag
  145.             ' is officially over.
  146.  
  147.             'KindFrame(DragIndex).BackColor = LTGREY
  148.  
  149.         Case MASK_OLDAPPT
  150.  
  151.             ' If this is an item dragged from the grid, refresh
  152.             ' the grid in case the drag ended outside the grid
  153.             ' frame (and the inverted row remains).
  154.  
  155.             'ApptList.Refresh
  156.  
  157.     End Select
  158.  
  159.     Dragging = False
  160.     DragTesting = False
  161.     EndDragMode = (mask And DragType) <> 0
  162.     
  163. End Function
  164.  
  165. Sub GetMarquee (DragGrid As Control, Marquee As RECT)
  166.  
  167. ' Return the bounding box of the marquee, in screen coordinates
  168.  
  169.     Dim GridOrigin As POINTAPI
  170.     Dim GridCorner As POINTAPI
  171.  
  172.     N& = SendMessage(DragGrid.Hwnd, GRM_GETCELLRECT, 0, Marquee)
  173.  
  174.     GridOrigin.X = Marquee.Left
  175.     GridOrigin.Y = Marquee.Top
  176.     GridCorner.X = Marquee.Right
  177.     GridCorner.Y = Marquee.Bottom
  178.  
  179.     ClientToScreen DragGrid.Hwnd, GridOrigin
  180.     ClientToScreen DragGrid.Hwnd, GridCorner
  181.  
  182.     Marquee.Left = GridOrigin.X
  183.     Marquee.Top = GridOrigin.Y
  184.     Marquee.Right = GridCorner.X
  185.     Marquee.Bottom = GridCorner.Y
  186. End Sub
  187.  
  188. Sub GridMaybeDrag (ctl As Control, X As Single, Y As Single)
  189.     
  190.     ' Called by MouseDown handlers to see whether or not
  191.     ' dragging is a *possibility* after some motion.
  192.  
  193.     If Not CursorInRow(ctl) Then Exit Sub
  194.     InitialX = X
  195.     InitialY = Y
  196.     DragTesting = True
  197. End Sub
  198.  
  199. Sub GridTestDrag (ctl As Control, Button As Integer, X As Single, Y As Single, objType As Integer, dicon As Control)
  200.     
  201.     ' Called during MouseMove by controls desiring drag
  202.     ' and drop behavior.
  203.  
  204.     If Button = 0 Then
  205.         DragTesting = False
  206.         Exit Sub
  207.     End If
  208.     If Not DragTesting Then Exit Sub
  209.     If Abs(InitialX - X) > DRAG_DELTA Or Abs(InitialY - Y) > DRAG_DELTA Then
  210.         ctl.DragIcon = dicon.DragIcon
  211.         BeginDragMode ctl, objType
  212.     End If
  213. End Sub
  214.  
  215.